(* Creme Caramel Compiler (Triple C) - Michele Caceffo - 2008 *)

open Syntaxtree;;
open Exceptions;;
open Intermediate;;
open Semantic;;
open Declaration;;
open Commands;;

(** Contains the functions to create the procedure/function table *)

(** Used to join two Hashtable into a single one *)
let jointable t1 t2 = let rettbl = Hashtbl.copy t1 in (Hashtbl.iter (Hashtbl.add rettbl) t2; rettbl)

(** Converts a param list into a dec list
    @param plist The param list
    @return The converted list
*)
(* LDL: this function has to be updated with the concept of formal parameter as a gType (it can include pointers as well) *)
let rec convertList (plist: param list) = match plist with
        []              ->  []
      | Par(id,gt)::ps   ->  [Dec(id,gt)]@convertList ps

(** Generate the Hashtable with the declaration of the parameters
    @param p The declaration list of the parameters
    @param pdect The dec_table for the parameters
    @return The updated table of parameters
*)
(* LDL: consider the case in which id is associated with a pointer value, even if the pointer expression is a record expression
        (so we need the rec_tree)
 *)
let genParamTable (p: dec list) (pdect: dec_table) (tdtable: typedef_table) = for n=0 to ((List.length p) - 1) do (
    match (List.nth p n) with
        Dec(id,Basic(Int))      ->  Hashtbl.add pdect id (1, 1, (Off(-n, DInt, true)))
      | Dec(id,Basic(Float))    ->  Hashtbl.add pdect id (1, 1, (Off(-n, DFloat, true)))
      | Dec(id,Pointer(pexp))   ->  let stype = (getSemanticGtype (Pointer(pexp)) pdect tdtable) in
				    Hashtbl.add pdect id (1, 1, (Off(-n, stype, true)))
      | Dec(id,Basic(UsrType(ut)))   ->  let stype = (getSemanticUsrType ut pdect tdtable) in
					 Hashtbl.add pdect id (1, 1, (Off(-n, stype, true)))
      | _                       ->  raise (SYNTAX_ERROR "Not allowed parameter type")
    ) done; pdect

(** Generates the Subroutine entry for the Hashtable, after creating a Hashtable containing all the declarations of 
    the local variables and the parameters; then is checked the semantic of the subroutine's body and finally the 
    intermediate code is generated and saved. To do this, a new FunUtils class is created and substituted to the 
    present one, in order to have new variables for offsets and labels, but not registers (which are common for all 
    functions/procedures/main )
    @param id The ide of the procedure
    @param pdeclist The dec list of the parameters
    @param dlist The local variables dec list
    @param dect The global variables declarations table
    @param proct The subroutines table
    @param c The body of the subroutine
    @param ic The intermediateCode class instance
    @param r The return type of the subroutine
    @return The built entry for the subroutine
*)
let genSubroutine (id: ide) (pdeclist: dec list) (dlist: dec list) (dect: dec_table) (proct: proc_table) (tdtable: typedef_table) (c: cmd) (ic: intermediateCode) (r: return)=
    let localVarTable = jointable (genDecTable (dlist) (Hashtbl.create 0) tdtable ic true) (genParamTable (pdeclist) (Hashtbl.create 0) tdtable) in
    let updatedTable = jointable dect localVarTable in
    if (cmdsemantic c updatedTable proct tdtable) then (
        let oldinstr = ic#getInstructionClass and 
        newInstr = (new funUtils) in (
            ic#setInstructionClass newInstr;
            (genCommand c updatedTable proct tdtable ic);
            match r with
                Void        ->  (
                                 ic#addInstr(RET, Null, Null, Null);
                                 let newInstr = ic#getInstructionClass in (
                                    ic#setInstructionClass oldinstr;
                                     Subroutine(r,pdeclist,localVarTable,newInstr);
                                 )
                                )
              | SRet(Int)   ->  (
                                 let (_,_,e) = (getVarDeclaration id localVarTable ) in 
                                 ic#addInstr(RET, e, Null, Null);
                                 let newInstr = ic#getInstructionClass in (
                                    ic#setInstructionClass oldinstr;
                                    Subroutine(r,pdeclist,localVarTable,newInstr);
                                 )
                                )
              | SRet(Float) ->  (
                                 let (_,_,e) = (getVarDeclaration id localVarTable) in 
                                 ic#addInstr(RET, e, Null, Null);
                                 let newInstr = ic#getInstructionClass in (
                                    ic#setInstructionClass oldinstr;
                                    Subroutine(r,pdeclist,localVarTable,newInstr);
                                 )
                                )
	      | SRet(UsrType(ut)) ->  (*
                                       let (_,_,e) = (getVarDeclaration id localVarTable) in 
				       ic#addInstr(RET, e, Null, Null);
				       let newInstr = ic#getInstructionClass in (
					 ic#setInstructionClass oldinstr;
					 Subroutine(r,pdeclist,localVarTable,newInstr);
				       )
                                      *)
		                      let msg = "It is not possible to return records from functions. " ^
					"This point of subroutines.ml is structurally unreachable becouse of static semantics."
				      in raise (CONFIRM_RULE msg)
            )
    )else (
        raise (SEMANTIC_ERROR "Error while defining subroutine\n")
    )

(** Builds the Building entry for the Hashtable and then replaces it with the Subroutine entry, which is build by the genSubruotine method.
    This is done in order to avoid errors with recursive calls, because until the entry is created, the function call raises 
    a Not_found exception. In the Building entry there are only the informations to check semantic errors.
    @param p The subroutine to create
    @param dect The declaration table
    @param proct The subroutines table
    @param ic The intermediatecCode class instance
    @return The updated subroutines table
*)
(* LDL: this function has to be updated with the concept of formal parameter as a gType (it can include pointers as well) *)
let genSub (p: proc) (dect: dec_table) (proct: proc_table) (tdtable: typedef_table) (ic: intermediateCode) = match p with
        Proc(id,plist,dlist,c)          ->  (
                                             let convertedPlist = (convertList ([(Par(id,Basic(Int)))]@plist)) in
                                             Hashtbl.add proct id (Building(Void, convertedPlist));
                                             Hashtbl.replace proct id (genSubroutine id (convertedPlist) dlist dect proct tdtable c ic Void)
                                            )
      | Func(id,plist,Ret(r),dlist,c)   ->  (
                                             let convertedPlist = (convertList ([(Par(id,Basic(r)))]@plist)) in
                                             Hashtbl.add proct id (Building(SRet(r), convertedPlist));
                                             Hashtbl.replace proct id (genSubroutine id (convertedPlist) dlist dect proct tdtable c ic (SRet(r)))
                                            )

(** Generate the subroutines table from the proc list
    @param procl The proc list
    @param dect The declarations table
    @param table The subroutines table
    @param ic The intermediateCode class instance
    @return The updated subroutines table
*)
let rec genSubTable (procl: proc list) (dect: dec_table) (tdtable: typedef_table) (table: proc_table) (ic: intermediateCode) = match procl with
        []      ->  table
      | p::ps   ->  (genSub p dect table tdtable ic); genSubTable ps dect tdtable table ic
